perm filename DESCRI.LSP[MRS,LSP] blob
sn#702118 filedate 1983-03-18 generic text, type T, neo UTF8
;;; This file contains the $describe package for mrs. It builds
;;; an index of the positions (and files) of forms like:
;;; (DESCRIPTION <key> <text>)
;;; and puts them on a list pointed to by $describe-position-alist.
;;; The text is just long atom names that should be thrown out
;;; after they are read.
(gctwa t)
(eval-when (compile)
(special $describe-position-alist))
(defun $describe (a)
(let ((position (assq a $describe-position-alist)))
(cond (position (apply 'filepos (cdr position))
(princ (caddr (read (cadr position))))
(terpri))
(t (princ '|No description.|)
(terpri)))))
;;; This reads a file and returns an index for it.
(defun read-dat-file (file)
(let ((handle (open file '(in ascii block))))
(do ((position 0 (filepos handle))
(descr (read handle) (read handle))
(index))
((eq descr 'stop) index)
(cond ((eq (car descr) 'description)
(setq index (cons (cons (cadr descr) (list handle position))
index)))))))
(setq $describe-position-alist (read-dat-file '|mrs:describe.dat|))